library(shiny)
library(tidyverse)
library(shinythemes)
Warning: package ‘shinythemes’ was built under R version 4.1.2
library(stringi)
library(RColorBrewer)
seabirds_cleaned_data <- read_csv("clean_data/seabirds_cleaned_data.csv")
Rows: 49020 Columns: 52
-- Column specification ---------------------------------------------------
Delimiter: ","
chr (19): common_name, scientific_name, species_abbreviation, age, plp...
dbl (28): record_x, record_id, wanplum, total_sighting, num_feeding, n...
lgl (3): sex, air_temp, salinity
dttm (2): date, time
i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
birds_21 <- seabirds_cleaned_data %>%
mutate(bird_type = case_when(
str_detect(common_name,
regex("shearwater",
ignore_case = TRUE)) ~ "Shearwater",
str_detect(common_name,
regex("albatross",
ignore_case = TRUE)) ~ "Albatross",
str_detect(common_name,
regex("mollymawk",
ignore_case = TRUE)) ~ "Mollymawk",
str_detect(common_name,
regex("petrel",
ignore_case = TRUE)) ~ "Petrel",
str_detect(common_name,
regex("prion",
ignore_case = TRUE)) ~ "Prion",
str_detect(common_name,
regex("skua",
ignore_case = TRUE)) ~ "Skua",
str_detect(common_name,
regex("penguin",
ignore_case = TRUE)) ~ "Penguin",
str_detect(common_name,
regex("tropicbird",
ignore_case = TRUE)) ~ "Tropicbird",
str_detect(common_name,
regex("noddy",
ignore_case = TRUE)) ~ "Noddy",
str_detect(common_name,
regex("tern",
ignore_case = TRUE)) ~ "Tern",
str_detect(common_name,
regex("gull",
ignore_case = TRUE)) ~ "Gull",
str_detect(common_name,
regex("booby",
ignore_case = TRUE)) ~ "Booby",
str_detect(common_name,
regex("frigatebird",
ignore_case = TRUE)) ~ "Frigatebird",
str_detect(common_name,
regex("shag",
ignore_case = TRUE)) ~ "Shag",
str_detect(common_name,
regex("sheathbill",
ignore_case = TRUE)) ~ "Sheathbill",
str_detect(common_name,
regex("fulmar",
ignore_case = TRUE)) ~ "Fulmar",
str_detect(common_name,
regex("gannet",
ignore_case = TRUE)) ~ "Gannet",
str_detect(common_name,
regex("cormorant",
ignore_case = TRUE)) ~ "Cormorant",
str_detect(common_name,
regex("procellaria",
ignore_case = TRUE)) ~ "Procellaria",
TRUE ~ common_name))
birds_21
birds_21 %>%
arrange(date)
# https://r-charts.com/color-palette-generator/
# https://www.statology.org/color-by-factor-ggplot2/
birds_pal <- c("#50e2ea", "#4edae5", "#4bd2df", "#49cada", "#47c2d4",
"#45bbcf", "#42b3c9", "#40abc4", "#3ea3be", "#3b9bb9",
"#3993b3", "#378bae", "#3483a8", "#327ba3", "#30739d",
"#2e6c98", "#2b6492", "#295c8d", "#275487", "#244c82", "#22447c")
names(birds_pal) <- levels(birds_21$bird_type)
custom_colors <- scale_colour_manual(values = birds_pal)
birds <- c("Tropicbird" = "#50e2ea", "Tern" = "#4edae5", "Skua" = "#4bd2df",
"Sheathbill" = "#49cada", "Shearwater" = "#47c2d4",
"Shag" = "#45bbcf", "Seabird" = "#42b3c9", "Procellaria" = "#40abc4",
"Prion" = "#3ea3be", "Petrel" = "#3b9bb9", "Penguin" = "#3993b3",
"Noddy" = "#378bae", "Mollymawk" = "#3483a8", "Jaeger" = "#327ba3",
"Gull" = "#30739d", "Gannet" = "#2e6c98", "Fulmar" = "#2b6492",
"Frigatebird" = "#295c8d", "Cormorant" = "#275487",
"Booby" = "#244c82", "Albatross" = "#22447c")
Jaeger Seabird
birds_21 %>%
filter(!is.na(bird_type)) %>%
count(bird_type)
NA
sighting <- birds_21 %>%
filter(!is.na(bird_type)) %>%
group_by(bird_type) %>%
summarise(count = sum(total_sighting, na.rm = TRUE)) %>%
mutate(sighting_id = row_number())
sighting %>%
ggplot() +
aes(y = bird_type,
x = count, fill = bird_type) +
geom_col(colour = "black") +
theme(legend.position = "none") +
scale_x_continuous(breaks = c(1, 5, 10, 1000, 6000, 1400000),
limits = c(1,1400000),
trans = "log10") +
labs(y = "\n Bird Names",
x = "Number of Birds Seen \n Log10 scale") +
scale_fill_manual(values = birds)
# log10() as 1 or more birds are less than 10 and don't show on normal graph
1,394,468
feeding <- birds_21 %>%
group_by(bird_type) %>%
filter(str_detect(feeding, "YES")) %>%
summarise(count = n()) %>%
mutate(feeding_id = row_number())
feeding %>%
ggplot() +
aes(y = bird_type,
x = count, fill = bird_type) +
geom_col(colour = "black") +
theme(legend.position = "none") +
scale_x_continuous(breaks = c(1, 5, 10, 100, 300, 800),
limits = c(1,800),
trans = "log10") +
labs(y = "\n Bird Names",
x = "Number of Birds Seen Feeding \n Log10 scale") +
scale_fill_manual(values = birds)
# log10() as 1 or more birds are less than 10 and don't show on normal graph
on_ship <- birds_21 %>%
group_by(bird_type) %>%
filter(str_detect(on_ship, "YES")) %>%
summarise(count = n()) %>%
mutate(on_ship_id = row_number())
on_ship %>%
ggplot() +
aes(y = bird_type,
x = count, fill = bird_type) +
geom_col(colour = "black") +
theme(legend.position = "none") +
scale_x_continuous(breaks = c(1, 2, 3, 5, 7, 10, 60),
limits = c(1,60),
trans = "log10") +
labs(y = "\n Bird Names",
x = "Number of Birds Seen On Ship") +
scale_fill_manual(values = birds)
in_hand <- birds_21 %>%
group_by(bird_type) %>%
filter(str_detect(in_hand, "YES")) %>%
summarise(count = n()) %>%
mutate(in_hand_id = row_number())
in_hand %>%
ggplot() +
aes(y = bird_type,
x = count, fill = bird_type) +
geom_col(colour = "black") +
theme(legend.position = "none") +
labs(y = "\n Bird Names",
x = "Number of Birds Seen In Hand") +
scale_fill_manual(values = birds)
# https://stackoverflow.com/questions/14255533/pretty-ticks-for-log-normal-scale-using-ggplot2-dynamic-not-manual
# https://stackoverflow.com/questions/43974892/dynamic-limits-and-breaks-in-scale-y-continuous
fly_by <- birds_21 %>%
group_by(bird_type) %>%
filter(str_detect(fly_by, "YES")) %>%
summarise(count = n()) %>%
mutate(fly_by_id = row_number())
# base_breaks <- function(n = 10){
# function(x) {
# axisTicks(log10(range(fly_by$count, na.rm = TRUE)),
# log = if_else(max(fly_by$count) > 1000, TRUE, FALSE), n = n)
# }
# }
# asd <- if_else(max(fly_by$count) < 1000, c(limits=c(0,max(fly_by$count)),
# breaks = seq(0,max(fly_by$count),
# by = round(max(fly_by$count)/5))),
# c(limits=c(0,max(fly_by$count)),
# breaks = seq(0,max(fly_by$count),
# by = round(max(fly_by$count)/5)),
# trans = "log10")
# )
fly_by %>%
ggplot() +
aes(y = bird_type,
x = count, fill = bird_type) +
geom_col(colour = "black") +
theme(legend.position = "none") +
scale_x_continuous(limits=c(0,max(fly_by$count)),
breaks = c(seq(0,max(fly_by$count),
by = (max(fly_by$count)/5))), trans = "log10"
#validate(max(fly_by$count) < 1000, trans = "log10")
) +
labs(y = "\n Bird Names",
x = "Number of Birds Seen Flying BY\n Log10 scale") +
scale_fill_manual(values = birds)
Error in seq.default(a, b, length.out = n + 1) :
'from' must be a finite number
breaks = c(1, 5, 10, 1000, 6000), limits = c(1,6000), trans = “log10”
variants <- birds_21 %>%
filter(bird_type == "Albatross") %>%
group_by(common_name) %>%
summarise(count = n())
variants %>%
ggplot() +
aes(y = common_name,
x = count, fill = common_name) +
geom_col(colour = "black") +
theme(legend.position = "none") +
scale_x_continuous(
trans = "log10") +
labs(y = "\n Bird Names",
x = "Number of Birds Seen Flying BY\n Log10 scale") +
scale_fill_manual(values = birds_pal)
variants <- birds_21 %>%
filter(bird_type == "Booby") %>%
group_by(common_name) %>%
summarise(count = n())
variants %>%
ggplot() +
aes(y = common_name,
x = count, fill = common_name) +
geom_col(colour = "black") +
theme(legend.position = "none") +
scale_x_continuous(
trans = "log10") +
labs(y = "\n Bird Names",
x = "Number of Birds Seen Flying BY\n Log10 scale") +
scale_fill_manual(values = birds_pal)
variants <- birds_21 %>%
filter(bird_type == "Cormorant") %>%
group_by(common_name) %>%
summarise(count = n())
variants %>%
ggplot() +
aes(y = common_name,
x = count, fill = common_name) +
geom_col(colour = "black") +
theme(legend.position = "none") +
scale_x_continuous(
trans = "log10") +
labs(y = "\n Bird Names",
x = "Number of Birds Seen Flying BY\n Log10 scale") +
scale_fill_manual(values = birds_pal)
variants <- birds_21 %>%
filter(bird_type == "Tropicbird") %>%
group_by(common_name) %>%
summarise(count = n())
variants %>%
ggplot() +
aes(y = common_name,
x = count, fill = common_name) +
geom_col(colour = "black") +
theme(legend.position = "none") +
scale_x_continuous() +
labs(y = "\n Bird Names",
x = "Number of Birds Seen Flying BY\n Log10 scale") +
scale_fill_manual(values = birds_pal)
library(shiny)
library(tidyverse)
library(shinythemes)
#seabirds_cleaned_data <- read_csv("data/seabirds_cleaned_data.csv")
# birds_9 <- seabirds_cleaned_data %>%
# group_by(common_name) %>%
# mutate(common_name = if_else(str_detect(common_name,
# "(?i)shearwater"),"Shearwater",
# common_name),
# common_name = if_else(str_detect(common_name,
# "(?i)albatross"), "Albatross",
# common_name),
# common_name = if_else(str_detect(common_name,
# "(?i)mollymawk"), "Mollymawk",
# common_name),
# common_name = if_else(str_detect(common_name,
# "(?i)petrel"), "Petrel",
# common_name),
# common_name = if_else(str_detect(common_name,
# "(?i)prion"), "Prion",
# common_name),
# common_name = if_else(str_detect(common_name,
# "(?i)skua"), "Skua",
# common_name),
# common_name = if_else(str_detect(common_name,
# "(?i)penguin"), "Penguin",
# common_name),
# common_name = if_else(str_detect(common_name,
# "(?i)Red-tailed tropicbird"),
# "Red-tailed tropicbird",
# common_name),
# common_name = if_else(str_detect(common_name,
# "(?i)Brown noddy"), "Brown noddy",
# common_name)
# ) %>%
# filter(common_name %in% c("Shearwater", "Albatross",
# "Mollymawk", "Petrel",
# "Prion", "Skua",
# "Penguin", "Brown noddy",
# "Red-tailed tropicbird"))
# pal <- c("Shearwater" = "grey", "Albatross" = "blue",
# "Mollymawk" = "yellow", "Petrel" = "green",
# "Prion" = "pink", "Skua" = "purple",
# "Penguin" = "orange", "Brown noddy" = "brown",
# "Red-tailed tropicbird" = "red")
# names(birds_9)
# head(birds_9)
# birds_9 %>%
# group_by(common_name) %>%
# mutate(feeding = if_else(feeding %in% "YES", 1, 0),
# on_ship = if_else(on_ship %in% "YES", 1, 0),
# in_hand = if_else(in_hand %in% "YES", 1, 0),
# fly_by = if_else(fly_by %in% "YES", 1, 0)) %>%
# summarise(sighting_count = sum(total_sighting, na.rm = TRUE),
# feeding_count = sum(feeding, na.rm = TRUE),
# on_ship_count = sum(on_ship, na.rm = TRUE),
# in_hand_count = sum(in_hand, na.rm = TRUE),
# fly_by_count = sum(fly_by, na.rm = TRUE))
library(leaflet)
getColor <- function(sight_map) {
sapply(sight_map$bird_type, function(sight_map) {
case_when(sight_map$bird_type == "Tropicbird" ~ "#50e2ea",
sight_map$bird_type == "Tern" ~ "#4edae5",
sight_map$bird_type == "Skua" ~ "#4bd2df",
sight_map$bird_type == "Sheathbill" ~ "#49cada",
sight_map$bird_type == "Shearwater" ~ "#47c2d4",
sight_map$bird_type == "Shag" ~ "#45bbcf",
sight_map$bird_type == "Seabird" ~ "#42b3c9",
sight_map$bird_type == "Procellaria" ~ "#40abc4",
sight_map$bird_type == "Prion" ~ "#3ea3be",
sight_map$bird_type == "Petrel" ~ "#3b9bb9",
sight_map$bird_type == "Penguin" ~ "#3993b3",
sight_map$bird_type == "Noddy" ~ "#378bae",
sight_map$bird_type == "Mollymawk" ~ "#3483a8",
sight_map$bird_type == "Jaeger" ~ "#327ba3",
sight_map$bird_type == "Gull" ~ "#30739d",
sight_map$bird_type == "Gannet" ~ "#2e6c98",
sight_map$bird_type == "Fulmar" ~ "#2b6492",
sight_map$bird_type == "Frigatebird" ~ "#295c8d",
sight_map$bird_type == "Cormorant" ~ "#275487",
sight_map$bird_type == "Booby" ~ "#244c82",
sight_map$bird_type == "Albatross" ~ "#22447c",
TRUE ~ sight_map$bird_type
) })
}
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = list("Tropicbird" = "#50e2ea", "Tern" = "#4edae5", "Skua" = "#4bd2df",
"Sheathbill" = "#49cada", "Shearwater" = "#47c2d4",
"Shag" = "#45bbcf", "Seabird" = "#42b3c9", "Procellaria" = "#40abc4",
"Prion" = "#3ea3be", "Petrel" = "#3b9bb9", "Penguin" = "#3993b3",
"Noddy" = "#378bae", "Mollymawk" = "#3483a8", "Jaeger" = "#327ba3",
"Gull" = "#30739d", "Gannet" = "#2e6c98", "Fulmar" = "#2b6492",
"Frigatebird" = "#295c8d", "Cormorant" = "#275487",
"Booby" = "#244c82", "Albatross" = "#22447c")
)
# test inputs so they look like what shiny will give us for user inputs.
input <- list(
sight_input = "Cormorant"
)
sight_map <- birds_21 %>%
filter(bird_type %in% input$sight_input)
sight_map%>%
leaflet() %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addAwesomeMarkers(~long, ~lat, icon=icons,
label = sight_map$common_name,
clusterOptions = markerClusterOptions())
# Print the map
getColor <- function(quakes) { sapply(position$date, function(date) { case_when(str_detect(date, regex(“^196”, ignore_case = TRUE)) ~ “green”, str_detect(date, regex(“^197”, ignore_case = TRUE)) ~ “orange”, str_detect(date, regex(“^198”, ignore_case = TRUE)) ~ “blue”, str_detect(date, regex(“^199”, ignore_case = TRUE)) ~ “red”
) }) }
icons <- awesomeIcons( icon = ‘ios-close’, iconColor = ‘black’, library = ‘ion’, markerColor = getColor(position) )
leaflet(position) %>% addTiles() %>% addAwesomeMarkers(~long, ~lat, icon=icons, label=~as.character(date))
-45.91667 165.4000
seabirds_cleaned_data
ship_data <- read_excel(here("raw_data/seabirds.xls"),
sheet = "Ship data by record ID") %>%
clean_names()
position <- ship_data %>%
select(date, lat, long) %>%
filter(!is.na(lat),
!is.na(long)) %>%
group_by(date) %>%
summarise_if(is.numeric, mean)
position
ship_data %>%
select(date, lat, long) %>%
filter(is.na(date))
tail(position)
leaflet(data = position) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addMarkers(label = position$date, clusterOptions = markerClusterOptions())
# Print the map
# https://rstudio.github.io/leaflet/markers.html
# first 20 quakes
df.20 <- quakes[1:20,]
getColor <- function(quakes) {
sapply(position$date, function(date) {
if(date <= 1979-12-31) {
"green"
} else if(date <= 1989-12-31) {
"orange"
} else {
"red"
} })
}
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = getColor(position)
)
leaflet(position) %>% addTiles() %>%
addAwesomeMarkers(~long, ~lat, icon=icons, label=~as.character(date))
getColor <- function(quakes) {
sapply(position$date, function(date) {
if(date %in% "^196") {
"green"
} else if(date %in% "^197") {
"orange"
} else if(date %in% "^198") {
"blue"
} else {
"red"
} })
}
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = getColor(position)
)
leaflet(position) %>% addTiles() %>%
addAwesomeMarkers(~long, ~lat, icon=icons, label=~as.character(date))
getColor <- function(quakes) {
sapply(position$date, function(date) {
case_when(str_detect(date,
regex("^196",
ignore_case = TRUE)) ~ "green",
str_detect(date,
regex("^197",
ignore_case = TRUE)) ~ "orange",
str_detect(date,
regex("^198",
ignore_case = TRUE)) ~ "blue",
str_detect(date,
regex("^199",
ignore_case = TRUE)) ~ "red"
) })
}
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = getColor(position)
)
leaflet(position) %>% addTiles() %>%
addAwesomeMarkers(~long, ~lat, icon=icons, label=~as.character(date))
# https://stackoverflow.com/questions/56362519/how-to-filter-date-range-for-routes-in-r-leaflet-shiny-app
library(dplyr)
library(shiny)
library(leaflet)
library(readxl)
library(RColorBrewer)
library(maps)
Warning: package ‘maps’ was built under R version 4.1.3
Attaching package: ‘maps’
The following object is masked from ‘package:purrr’:
map
library(leaflet.extras)
Warning: package ‘leaflet.extras’ was built under R version 4.1.3
library(htmlwidgets)
Warning: package ‘htmlwidgets’ was built under R version 4.1.2
data_dots = read_csv("test4.csv")
Rows: 8 Columns: 14
-- Column specification ---------------------------------------------------
Delimiter: ","
chr (6): Name, ship_date, delivery_date, ShipmentID, Dcity, Origin
dbl (8): Dzip, Dlong, Dlat, Route, Seq, Ozip, Olong, Olat
i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
dateRangeInput("dateRange", "Date Range Input", start = min(data_dots$ship_date), end = max(data_dots$ship_date))
)
)
Warning: Couldn't coerce the `end` argument to a date string with format yyyy-mm-dd
server <- function(input, output) {
#n <- 60
qual_col_pals = brewer.pal.info[brewer.pal.info$category == 'qual', ]
col_vector = unlist(mapply(brewer.pal, qual_col_pals$maxcolors, rownames(qual_col_pals)))
myMap = leaflet("map") %>%
addTiles(group = "Base") %>%
addProviderTiles(providers$CartoDB.Positron, group = "Grey") %>%
addResetMapButton()
rv <- reactiveValues(
filteredData =data_dots,
ids = unique(data_dots$Route)
)
observeEvent(input$dateRange,
{rv$filteredData = data_dots[as.Date(data_dots$ship_date) >= input$dateRange[1] & as.Date(data_dots$ship_date) <= input$dateRange[2],]
rv$ids = unique(rv$filteredData$Route)
}
)
# Initiate the map
output$map <- renderLeaflet({
for (i in rv$ids) {
#print(i)
myMap = myMap %>%
addPolylines(
data = subset(rv$filteredData, Route == i),
weight = 3,
color = sample(col_vector, 1),
opacity = 0.8,
smoothFactor = 1,
lng = ~Dlong,
lat = ~Dlat,
highlight = highlightOptions(
weight = 5,
color = "blue",
bringToFront = TRUE
),
label = ~ as.character(ShipmentID),
popup = ~ as.character(ShipmentID),
group = "test"
)
}
myMap
})
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:7348
Warning: Error in charToDate: character string is not in a standard unambiguous format
[No stack trace available]
NA
data_dots %>%
mutate(ship_date = as.Date(ship_date, "%y/%m/%d"),
delivery_date = as.Date(delivery_date, "%y/%m/%d"))
Error in mutate(., ship_date = as.Date(ship_date, "%y/%m/%d"), delivery_date = as.Date(delivery_date, :
object 'data_dots' not found